home *** CD-ROM | disk | FTP | other *** search
- ;; markring.mut : Maintain a ring of marks so it is easy to jump to
- ;; often referenced places in a buffer.
- ;; Notes:
- ;; Marking regions does not effect the ring.
- ;; Each buffer has its own ring.
- ;; When the ring is full, the ring wraps around.
- ;; Be sure to add (markring-init) to (buffer-created-hook) and
- ;; (read-file-hook).
- ;; Marks may invalided without my knowing about it (eg buffer is
- ;; cleared). This would make (goto-mark) choke.
- ;; Data structure:
- ;; A list of mark ids acting like a stack:
- ;; oldest mmark -> element0, element1, ..., elementn <- youngest mark
- ;; When a mark is set, it is put at the end of the stack.
- ;; When popping a mark, take it off the start of the stack.
- ;; Uses:
- ;; Buffer variables:
- ;; mark-ring: list of mark ids.
- ;; C Durland rewritten to use lists: 9/91 Public Domain
- ;; Changed from queues to stacks: 2/92
-
- (include me2.h)
-
- (const
- NUMBER-OF-MARKS-IN-RING 4
- )
-
- (defun
- markring-init
- {
- (create-buffer-var LIST "mark-ring")
- (markring-reset)
- }
- markring-reset HIDDEN
- {
- (int num-marks n)
- (list ring)
-
- ; (ring (loc (buffer-var "mark-ring")))
- (ring (buffer-var "mark-ring"))
- (num-marks (length-of ring))
-
- (for (n 0) (< n num-marks) (+= n 1) (free-mark (extract-element ring n)))
- (remove-elements ring 0 1000)
- (buffer-var "mark-ring" ring)
- }
- MAIN
- {
- (register-hook IBUFFER-CREATED-HOOK "markring-init")
- (register-hook IREAD-FILE-HOOK "markring-init")
- ;;;!!! need a buffer-cleared-hook
-
- (bind-to-key "markring-push" "F-9")
- (bind-to-key "markring-push" "M-C-p")
- (bind-to-key "markring-pop" "M-p")
- }
- )
-
-
- ;; Put a mark in the mark ring.
- (defun
- markring-push
- {
- (int mark)
- (list ring)
-
- ; (ring (loc (buffer-var "mark-ring")))
- (ring (buffer-var "mark-ring"))
-
- (if (< (length-of ring) NUMBER-OF-MARKS-IN-RING) ;; need a new mark
- (mark (create-mark TRUE)) ;; a new mark
- (mark (pop-mark ring))) ;; ring full, reuse oldest mark
- (push-mark ring mark)
- (buffer-var "mark-ring" ring)
-
- (set-mark mark)
- (msg "Mark queued.")
- }
- )
-
-
- (defun
- markring-pop ;; Cycle through the mark ring
- {
- (int mark)
- (list ring)
-
- ;; !!! (if (no-markring) (markring-init))
-
- ; (ring (loc (buffer-var "mark-ring")))
- (ring (buffer-var "mark-ring"))
-
- (if (== 0 (length-of ring)) { (msg "Mark ring empty.")(done) })
-
- (mark (pop-mark ring))
- (push-mark ring mark)
- (buffer-var "mark-ring" ring)
-
- (goto-mark mark)
- }
- )
-
- (defun
- markring-delete ;; remove youngest mark from ring (usually just popped)
- {
- (int num-marks mark n)
- (list ring)
-
- ; (ring (loc (buffer-var "mark-ring")))
- (ring (buffer-var "mark-ring"))
-
- (num-marks (length-of ring)) ;; number of marks in ring
- (if (== 0 num-marks) { (msg "Mark ring empty.")(done) })
-
- (n (- num-marks 1))
-
- (mark (extract-element ring n)) (free-mark mark)
- (remove-elements ring n 1)
-
- (buffer-var "mark-ring" ring)
- }
- )
-
- (defun
- push-mark (list ring)(int mark) HIDDEN
- {
- (insert-object ring 10000 mark) ;; add to end of ring
- }
- pop-mark (list ring) HIDDEN
- {
- (int mark)
-
- (mark (extract-element ring 0))
- (remove-elements ring 0 1)
- mark
- }
- )
-